home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / incoming / jstools-.6v3 / jstools- / jstools-tk3.6v3.0 / lib / jprefixmatch.tcl < prev    next >
Encoding:
Text File  |  1995-02-09  |  2.4 KB  |  64 lines

  1. # jprefixmatch.tcl - utility procedures for prefix matching/expansion
  2. # Copyright 1992-1994 by Jay Sekora.  All rights reserved, except 
  3. # that this file may be freely redistributed in whole or in part 
  4. # for non¡profit, noncommercial use.
  5. ######################################################################
  6.  
  7. ######################################################################
  8. # j:longest_match l - longest common initial string in list l
  9. #   used by tab-expansion in filename dialogue box
  10. ######################################################################
  11. # this needs commenting desperately
  12.  
  13. proc j:longest_match { l } {
  14.   case [llength $l] in {
  15.     {0} { return {} }
  16.     {1} { return [lindex $l 0] }
  17.   }
  18.   set first [lindex $l 0]
  19.   set matchto [expr {[string length $first] - 1}]
  20.   for {set i 1} {$i < [llength $l]} {incr i} {
  21.     set current [lindex $l $i]
  22.     # if they don't match up to matchto, find new matchto
  23.     if { [string compare \
  24.            [string range $first 0 $matchto] \
  25.            [string range $current 0 $matchto]] } {
  26.       # loop, decreasing matchto until the strings match that far
  27.       for {} \
  28.           {[string compare \
  29.               [string range $first 0 $matchto] \
  30.               [string range $current 0 $matchto]] } \
  31.           {incr matchto -1 } \
  32.           {}            ;# don't need to do anything in body
  33.     } ;# end if they didn't already match up to matchto
  34.   } ;# end for each element in list
  35.   if {$matchto < 0} then {
  36.     return {}
  37.   } else {
  38.     return [string range $first 0 $matchto]
  39.   }
  40. }
  41.  
  42. ######################################################################
  43. # j:expand_filename f - expand filename prefix as much as possible
  44. #       (for use in file dialogue boxes)
  45. ######################################################################
  46. # note: if the filename has *, ?, or [...] in it, they will be used
  47. #       as part of the globbing pattern.  i declare this a feature.
  48.  
  49. proc j:expand_filename { f } {
  50.   set glob_list [glob -nocomplain "${f}*"]
  51.   set expansion [j:longest_match $glob_list]
  52.   if {$expansion == ""} {return $f}
  53.   # make sure it doesn't already end in "/":
  54.   set expansion [string trimright $expansion "/"]
  55.   # append / if the expansion is (1) unique, ie, not a prefix of another
  56.   #   file, and (2) a directory:
  57.   if {[file isdirectory $expansion] && [llength $glob_list] == 1} {
  58.     append expansion "/"
  59.   }
  60.   return $expansion
  61. }
  62.  
  63.